home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / rlib.zip / RL_BOXAS.PRG < prev    next >
Text File  |  1993-01-04  |  5KB  |  62 lines
  1. * Function: BOXASK
  2. * Author..: Richard Low
  3. * Syntax..: BOXASK( <expC> [,<expC>...] )
  4. * Returns.: Character pressed in response to a message displayed on screen
  5. *           after displaying each parameter (up to maximum of 9) on a
  6. *           separate line centered in a single line box.
  7. * Notes...: If the first parameter is a color setting, BOXASK will use
  8. *           that color combination instead of the default White on Red.
  9. *
  10.  
  11. FUNCTION BOXASK
  12.  
  13. PARAMETERS p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12
  14.  
  15. PRIVATE f_pcount, f_color, f_lines, f_indexp, f_brows, f_bcols, f_toprow,;
  16.         f_botrow, f_widest, f_x, f_pname, f_leftcol, f_ritecol, f_window,;
  17.         f_incolor, f_key, f_saverow, f_savecol, f_seconds
  18.  
  19. f_pcount  = PCOUNT()                                            && get param count, multiple calls to PCOUNT() do not work!
  20. f_pname   = 'p' + LTRIM(STR(f_pcount,2,0))
  21. f_seconds = 0                                                   && default is wait forever for keypress
  22. IF TYPE(f_pname) = 'N'                                          && if last parameter is numeric
  23.    f_seconds = &f_pname                                         && it is number of seconds to pause
  24.    f_pcount  = f_pcount - 1                                     && decrement parameter count
  25. ENDIF
  26. f_color   = SETCOLOR()                                          && default color is current color
  27. f_lines   = f_pcount                                            && 'parameter to display' count; assume each param is a line to display
  28. f_indexp  = 1                                                   && pointer to show which parm line to print
  29. f_saverow = ROW()                                               && save cursor position for restoration
  30. f_savecol = COL()                                               &&  on return
  31. IF STR(AT('/',p1),1,0) $ '234'                                  && if 1st parm is a color setting, a '/' will be at position 2,3, or 4
  32.    f_color  = p1                                                && use 1st parameter as color setting
  33.    f_indexp = 2                                                 && change parm pointer to next one
  34.    f_lines  = f_pcount - 1                                      && adjust 'parameter to display' count
  35. ENDIF
  36. f_brows  = 1                                                    && number of blank rows above and below message
  37. f_bcols  = 5                                                    && blank columns on either side of messages
  38. f_toprow = (10 + f_brows) - ROUND(f_lines / 2, 0)               && put in middle of screen with 2 lines above and below
  39. f_botrow = f_toprow + (2 * f_brows) + f_lines + 1               && calculate bottom row of window
  40. f_widest = 10                                                   && widest window width default is 10 columns
  41. FOR f_x = f_indexp TO f_pcount                                  && get widest width for window
  42.    f_pname  = 'p' + LTRIM(STR(f_x,2,0))
  43.    f_widest = MAX( f_widest, LEN(&f_pname) )
  44. NEXT f_x
  45. f_widest  = MIN( f_widest + (2 * f_bcols), 77 )                 && pad with (bcol) spaces on both sides, max width is 77 columns
  46. f_leftcol = (80 - f_widest) / 2                                 && calculate left column position
  47. f_ritecol = f_leftcol + f_widest + 1                            && calculate right column of window
  48. f_window  = SAVESCREEN(f_toprow,f_leftcol,f_botrow,f_ritecol)   && save what is underneath
  49. f_incolor = SETCOLOR(f_color)                                   && save old color an set to white on red, or color specified
  50. SCROLL(f_toprow,f_leftcol,f_botrow,f_ritecol,0)                 && clear screen and paint in designated color
  51. @ f_toprow,f_leftcol,f_botrow,f_ritecol BOX '┌─┐│┘─└│'          && draw box around window
  52. FOR f_x = f_indexp TO f_pcount                                  && get widest width for window
  53.    f_pname = 'p' + LTRIM(STR(f_x,2,0))                          && build name of parameter
  54.    @ f_toprow+f_brows+IF( f_lines=f_pcount, f_x, f_x-1 ),;
  55.      (80-LEN(&f_pname))/2 SAY SUBSTR(&f_pname,1,65)             && say it in the center of screen
  56. NEXT f_x
  57. f_key = INKEY(f_seconds)                                        && wait for keypress
  58. SETCOLOR(f_incolor)                                             && restore old color
  59. RESTSCREEN(f_toprow,f_leftcol,f_botrow,f_ritecol,f_window)      && restore what was underneath
  60. @ f_saverow,f_savecol SAY ''                                    && re-position the cursor to where it was on entry
  61. RETURN UPPER(CHR(f_key))                                        && return the character pressed
  62.